Gender Equity in Louisville

load("clean_svybydemog_data.RData")

Gender equity in Louisville is an unfortunately unequal reality. Women are worse off in key standard of living areas such as household income and homeownership. Additionally, these issues are exasperated for women from a one-income home, women with children, and minority women. Disproportionate cost of living burdens and care-taking responsibilities can perpetuate a viscous cycle of inequity. Understanding the true size of the ‘equity gap’ can help inform policy decisions to stop this cycle from continuing.

Key definitions:

• Cost-burdened household - when a household has to pay more than 30% of their income toward housing costs (including rent, utilities, mortgage payments, and any other homeownership costs.)
• Severely cost-burdened household - when a household has to pay more than 50% of their income toward housing costs.
• Single-income household and Multiple-earner household - A single-income household has only one wage earner, while a multiple-earner household includes multiple earners. Throughout the data, we usually group households into three groups:
  • Multiple-earner households
  • Single-earner, female-headed households
  • Single-earner, male-headed households

Key Takeaways:

1. Women and men in single-income households have very similar rates of homeownership in Louisville.
2. On average, women in single-income households make significantly less money on average than men from single-income households. As a result, almost half of Louisville women in single-income households are cost-burdened, putting them at increased risk of eviction or foreclosure.
3. Around 43% of women in single-income households earn a living wage that covers their basic expenses (around $30,000.) However, that number is only around 10% for single-income women with a child, only around 5% for single-income women with two children, and near 0% for single-income women with three or more children.
4. Compared to peer cities, Louisville has relatively high homeownership for women in single-income households with no children. However, for single-income women with children, we are second to last. Additionally, homeownership for women from a one-income household with children has been steadily decreasing since 2016.
5. Homeownership for single-income women is much lower for women of color.

Rolling mean explanation

Race categories explanation

GLP strives to use inclusive language and analyze data for traditionally underrepresented groups whenever possible. However, current data has its limitations. The terminology we use to describe race, sex, gender, and other identities mirrors the way questions were asked in the U.S. Census Bureau’s American Community Survey. Additionally, the survey does not provide us with enough information to create data on many populations in Louisville. When we break data down by race, we include data for white non-Hispanic residents, Black non-Hispanic residents, and Hispanic residents.

Data are often scarce for Hispanic and Latinx populations, as well for the LGBTQ+ population. National data we collect–for measures such as overdoses and certificates–are often unavailable at the zip code or neighborhood levels.

Waffle Chart

waffle_data <- survey_by_demog(lville_2019, "hh_type", other_grouping_vars = c("kd_pres", "earner_type"))

gender <- waffle_data %>%
  filter(
    race == "total",
    sex != "total",
    var_type == "population") %>%
  group_by(sex) %>%
  summarize(n = sum(cb_homeowner), .groups = "drop") %>%
  mutate(pct = n / sum(n) * 100)

earn_type <- waffle_data %>%
  filter(
    race == "total",
    sex != "total",
    var_type == "population") %>%
  group_by(sex, earner_type)  %>%
  summarize(n = sum(cb_homeowner), .groups = "drop") %>%
  mutate(pct = n / sum(n) * 100)

earn_type <- waffle_data %>%
  filter(
    race == "total",
    sex != "total",
    var_type == "estimate") %>%
  group_by(sex, earner_type)  %>%
  summarize(n = sum(cb_homeowner + noncb_homeowner),
            total = sum(cb_homeowner + noncb_homeowner + cb_renter + noncb_renter),
            .groups = "drop") %>%
  mutate(pct = n / sum(total) * 100)

earn_type <- waffle_data %>%
  filter(
    race == "total",
    sex != "total",
    var_type == "estimate") %>%
  group_by(sex, earner_type)  %>%
  summarize(n = sum(cb_homeowner + cb_renter),
            total = sum(cb_homeowner + noncb_homeowner + cb_renter + noncb_renter),
            .groups = "drop") %>%
  mutate(pct = n / sum(total) * 100)
  
demog_data <- data.frame(
  row_num = rep(1:10, each = 10),
  col_num = rep(10:1, 10),
  gender = c(rep("male", 52), rep("female", 48)),
  earn_type = c(rep("multi_earn", 28), rep("single_earn", 20), rep("multi_earn", 29), rep("single_earn", 23)))



knitr::include_url("https://greaterlou.shinyapps.io/gender_demogs/", height = "2500px")

# Single Earner Vs. Multiple Earner Women

t_df <- census_microdata081122 %>%
  filter(sex == "female")

prop.table(table(t_df$earner_type))

#single earner vs multi earner who women who happen to be head of household
#should we remove head of household filter?

Income

#fix formatting
single_earner_pctiles <- lville_2019 %>%
  group_by(sex) %>%
  summarize(
    ten_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.1),
    twenty_five_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.25),
    fifty_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.5),
    seventy_five_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.75),
    ninety_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.9))

library(gt) 

gt(single_earner_pctiles) %>%
  tab_header(title = "Income Percentiles by Sex",
             subtitle = "") %>%
  fmt_currency(columns = vars(ten_pct, twenty_five_pct, fifty_pct, seventy_five_pct,
                              ninety_pct),
                            use_subunits = F) %>%
  cols_label(ten_pct = "10th",
             twenty_five_pct = "25th",
             fifty_pct = "Median",
             seventy_five_pct   = "75th",
             ninety_pct = "90th") %>%
  cols_align(align = "center") %>%
      tab_source_note(
    source_note = md("Source: ACS microdata from IPUMS-USA")) %>%
  opt_row_striping(row_striping = TRUE) %>%
  opt_table_outline() %>%
  tab_options(
    table.font.size = px(12),
    table.width = pct(50)) %>%
  tab_style(
    cell_text(
      font = "Montserrat",
      weight = "bold"), 
    cells_row_groups())

by Gender

For single-adult households, a living wage is $33k for a single adult, $66k for an adult with one child, $84k for an adult with two children, and $112k for one adult and one child.

p <- lville_2019 %>% 
  filter(HHINCOME <= cut_95,
         earner_type == "single_earner") %>%
  func_plt_hist_overlay( "sex")

p <- p + glp_graph_theme

p <- p + labs(
  title = "Single Earner Income by Gender",
) +
  
  ylab(" ") +
  
  guides(color = FALSE) + 
  
  facet_wrap(~sex, nrow = 2) +
  
  theme(
  #axis.ticks.x =  element_line(size = 50000),
  strip.text = element_blank()

  )  +

scale_x_continuous(
  breaks = c(50000, 100000, 150000, 200000),
  label = c("$50k", "$100k", "$150k", "$200k")
) +
  scale_y_continuous(labels = scales::comma)

p

### Percent
temp_df <- lville_2019 %>% 
  filter(HHINCOME <= cut_95,
         earner_type == "single_earner")

  p_percent <- ggplot(temp_df, aes(x=HHINCOME, 
                                   y = (..count..)/sum(..count..),
                                   fill=sex, 
                                   color = sex, 
                                   weight = HHWT)) +
    geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000) +
    scale_fill_manual(values = c"#00A9B7", "#F58021")) +
    scale_color_manual(values = c("#00A9B7", "#F58021")) +

    labs(fill="") +
    xlab("Household Income") +
    ylab("Percentage") 

p_percent <- p_percent + glp_graph_theme

p_percent <- p_percent + labs(
  title = "Single Earner Income by Gender",
) +
  
  ylab(" ") +
  
  guides(color = FALSE) + 
  
  facet_wrap(~sex, nrow = 2) +
  
  theme(
  #axis.ticks.x =  element_line(size = 50000),
  strip.text = element_blank()

  )  +

scale_x_continuous(
  breaks = c(50000, 100000, 150000, 200000),
  label = c("$50k", "$100k", "$150k", "$200k")
) +
  scale_y_continuous(labels=percent)

p_percent

by Age

I_median_earn_age <- lville_2019 %>%
  group_by(age_group, earner_type_d) %>%
  summarize(Med=median(HHINCOME)) 

I_median_earn_age_plot <- ggplot(I_median_earn_age, 
       aes(x=age_group, y=Med, fill = earner_type_d)) + 
  geom_bar(stat="identity", position='dodge') 

I_median_earn_age_plot <- I_median_earn_age_plot + glp_graph_theme

I_median_earn_age_plot <- I_median_earn_age_plot +
  labs(
  title = "Median Earnings by Age Group",
) + 
  ylab("Household Income") +
  xlab("Age Group") +
  
  scale_y_continuous(labels = scales::dollar) +   
  scale_fill_manual(
    values = c("#0E4A99", "#F58021", "#00A9B7"), 
    labels = c("Multiple Earner", "Single Female Earner", "Single Male Earner"))

  
I_median_earn_age_plot

by Race

## original faceted graph...has been removed
sing_fem_inc_race<-census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    earner_type == 'single_earner',
    HHINCOME <= cut_95) 
  
   sing_fem_inc_race_plt <- sing_fem_inc_race %>%
   ggplot( aes(x=HHINCOME, 
              y = (..count..)/sum(..count..),
               fill=race, 
               color = race, 
               weight = HHWT)) +
    geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000) 


sing_fem_inc_race_plt <- sing_fem_inc_race_plt + facet_wrap(~race, nrow = 2) 

sing_fem_inc_race_plt <- sing_fem_inc_race_plt + glp_graph_theme

sing_fem_inc_race_plt <- sing_fem_inc_race_plt + 
  labs(
  title = "Female Single Earner Income",
) + 
  ylab(" ") +
  xlab("Household Income")
  
  # guides(color = FALSE)

sing_fem_inc_race_plt <- sing_fem_inc_race_plt + 
  
  theme( 
  #axis.ticks.x =  element_line(size = 50000),
  strip.text = element_blank()
  
  )  + 

scale_x_continuous(
  breaks = c(50000, 100000, 150000),
  label = c("$50k", "$100k", "$150k")
) +
  scale_y_continuous(labels = scales::percent)

sing_fem_inc_race_plt <- sing_fem_inc_race_plt +
  
  scale_fill_manual(values = c("#0E4A99", "#F58021","#00A9B7", "#800055")) +
  scale_color_manual(values = c("#0E4A99","#F58021","#00A9B7", "#800055")) 

sing_fem_inc_race_plt

Black

black_female_earner <- func_income_by_race("black")
black_female_earner

Hispanic

hisp_female_earner <- func_income_by_race("hispanic")
hisp_female_earner <- hisp_female_earner + 
  labs(
  title = "Hispanic Female Single Earner Income",
) + 
  scale_fill_manual(values = "#0E4A99") +
  scale_color_manual(values = "#0E4A99")
  
hisp_female_earner

White

white_female_earner <- func_income_by_race("white")
white_female_earner <- white_female_earner + 
  labs(
  title = "White Female Single Earner Income",
)  + 
  scale_fill_manual(values = "#F58021") +
  scale_color_manual(values = "#F58021")

white_female_earner

Other

other_female_earner <- func_income_by_race("other")
other_female_earner <- other_female_earner + 
  labs(
  title = "Other Female Single Earner Income",
) + 
  scale_fill_manual(values = "#00A9B7") +
  scale_color_manual(values = "#00A9B7")

other_female_earner

Compared to a Living Wage

func_income_by_kids <- function(num_kids, living_wage) {



  w <- census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    NCHILD == num_kids,
    earner_type == 'single_earner',
    HHINCOME <= cut_95) 
  
   w <- w %>%
   ggplot( aes(x=HHINCOME, 
              y = (..count..)/sum(..count..),
              fill = sex,
              group = sex,
               weight = HHWT)) +
    geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000) +
     geom_vline( aes(xintercept = living_wage), linetype = "dashed",  colour="blue", size = 1.5) 
   

#sing_fem_inc_race_plt <- sing_fem_inc_race_plt + facet_wrap(~race, nrow = 2) 

w <- w + glp_graph_theme

w <- w + 
  labs(
  title = "Black Female Single Earner Income",
) + 
  ylab(" ") +
  xlab("Household Income")+
  
  guides(color = FALSE)

w <- w + 
  
  theme( 
  #axis.ticks.x =  element_line(size = 50000),
  strip.text = element_blank()
  
  )  + 
  
scale_x_continuous(
  breaks = c(50000, 100000, 150000),
  label = c("$50k", "$100k", "$150k")
) +
  scale_y_continuous(labels = scales::percent) 
    
  
  return (w)

}

No Child

#why is color not working?
#still need to add living wage lines

under_liv_wage_0 <- census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    NCHILD == 0,
    earner_type == 'single_earner') %>%
  group_by(HHINCOME < 33321.6) %>%
  summarize(count = sum(HHWT)) #a little more than half are earning a living wage
#do this for each graphof this type...add info above chunk

no_kids_female_earner <- func_income_by_kids(0, 33321.6)
no_kids_female_earner <- no_kids_female_earner + 
  labs(
  title = "Female Single Earner Income, No Children",
) + 
  scale_fill_discrete(labels = "No Children")

no_kids_female_earner

1 Child

under_liv_wage_1 <- census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    NCHILD == 1,
    earner_type == 'single_earner') %>%
  group_by(HHINCOME < 66081.6) %>%
  summarize(count = sum(HHWT))

one_child <- func_income_by_kids(1, 66081.6)
one_child <- one_child + 
  labs(
  title = "Female Single Earner Income, One Child",
) + 
  scale_fill_manual(values = "#800055", labels = "One Child" ) +
  scale_color_manual(values = "#800055") 

one_child

2 Children

under_liv_wage_2 <- census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    NCHILD == 2,
    earner_type == 'single_earner') %>%
  group_by(HHINCOME < 83990.4) %>%
  summarize(count = sum(HHWT))

two_child <- func_income_by_kids(2, 83990.4)
two_child <- two_child + 
  labs(
  title = "Female Single Earner Income, Two Children",
) + 
  scale_fill_manual(values = "#356E39", labels = "Two Children") +
  scale_color_manual(values = "#356E39") 

two_child

3 Children

under_liv_wage_3 <- census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    NCHILD == 3,
    earner_type == 'single_earner') %>%
  group_by(HHINCOME < 111529.6) %>%
  summarize(count = sum(HHWT))

three_child <- func_income_by_kids(3, 111529.6)
three_child <- three_child + 
  labs(
  title = "Female Single Earner Income With Three Children",
) + 
  scale_fill_manual(values = "#CFB94C", labels = "Three Children") +
  scale_color_manual(values = "#CFB94C") 

three_child

## Avg Age of Women:Living Wage

age_liv_wage <- function(num_kids, living_wage) {

df <- census_microdata081122 %>% 
  filter(
    FIPS == "21111",
    year %in% 2016:2019,
    sex == 'female',
    NCHILD == num_kids,
    earner_type == 'single_earner',
    HHINCOME < living_wage) %>%
  #group_by(HHINCOME < living_wage) %>%
  summarize(Hmisc::wtd.mean(age, HHWT, na.rm=TRUE))

return(df)

}

# three_child <- func_income_by_kids(3, 101452.61)


under_liv_wage_0_age <- age_liv_wage(0, 30303.98) #61.2
under_liv_wage_1_age <- age_liv_wage(1, 60264.75) #38.9
under_liv_wage_2_age <- age_liv_wage(2, 76451.81) #34.9
under_liv_wage_3_age <- age_liv_wage(3, 101452.61) #32.7

Cost Burden

by Income

these_labels <- paste0(dollar(seq(1, 273500, 10000), scale = 0.001, accuracy = 1, suffix = "k"))

cost_burden_sf <- lville_2019 %>% 
  filter(
    sex == 'female',
    earner_type == 'single_earner',
    HHINCOME <= cut_95) %>%
  mutate(
    cost_burden = factor(cost_burden, 
                         levels = rev(c(TRUE, FALSE)), 
                         labels = rev(c("Cost Burdened", "Non Cost Burdened")), 
                         ordered = TRUE),
    inc_bins = cut(HHINCOME, seq(1, 283500, 10000),
                   labels = these_labels) %>%
      factor(levels = these_labels, ordered = TRUE)
    )
    
temp_df <- cost_burden_sf %>%
  group_by(inc_bins, cost_burden) %>%
  summarize(count = sum(HHWT), .groups = "drop") %>%
  complete(inc_bins, cost_burden, fill = list(count = 0)) %>%
  filter(!is.na(inc_bins)) %>%
  group_by(inc_bins) %>%
  mutate(percent = count / sum(count)) %>%
  ungroup() %>%
  filter(cost_burden == "Cost Burdened")
 
temp_df <- temp_df[1:14,]

cost_burden_sf_plot <- ggplot(temp_df, 
       aes(x = inc_bins,
           y = percent,
           group = 1)) +
  geom_line(linetype = "dashed", color="purple", size=3) +
  geom_point(color="purple", size=8)

cost_burden_sf_plot <- cost_burden_sf_plot + glp_graph_theme

cost_burden_sf_plot <- cost_burden_sf_plot + 
  labs(
  title = "Female Single Earner Cost Burden Level by Income",
) + 
  ylab(" ") +
  xlab("Household Income") +
  
  guides(color = FALSE) +
  
  theme(
  strip.text = element_blank()

  )  +

  scale_color_manual(values = c("#0E4A99")) +
  scale_y_continuous(labels = scales::percent)

cost_burden_sf_plot

by Age

cost_burden_age_sf %<>% drop_na(cost_burden) #this will need to be run once and then left alone if tweaking graphs

temp_df1 <- cost_burden_age_sf %>%
  filter(earner_type_d == "single_fem_earner") %>%
  mutate(
    age_group = case_when(
      age %in% 15:19 ~ NA_character_, 
      age %in% 20:29 ~ "20-29", 
      age %in% 30:39 ~ "30-39",  
      age %in% 40:49 ~ "40-49",  
      age %in% 50:59 ~ "50-59",  
      age %in% 60:69 ~ "60-69", 
      age %in% 70:79 ~ "70-79", 
      age >= 80 ~ "80+"))

temp_df1 %<>%  filter(!is.na(age_group))

cost_burden_age_sf_facet_plt <- ggplot(temp_df1,
       aes(x=age_group, y=HHWT , fill=cost_burden),
        color="#00A9B7") +
geom_bar(stat="identity", position='fill')
  
#facet_wrap(~earner_type_d)

cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + glp_graph_theme

cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + 
    theme(
    legend.position = "right",
    
    strip.text = element_text(size = 40)
    ) +
  labs(
  title = "Cost Burdened Status by Age and Earner Type",
) + 
  ylab(" ") +
  xlab(" ") +
  scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) + 
  scale_x_discrete(guide = guide_axis(n.dodge=2)) +

  scale_y_continuous(labels = scales::percent)

cost_burden_age_sf_facet_plt

Over Time

CB_earntype %<>%
  filter(
    race == 'total') %>%
  select( -race) %>%
  pivot_wider(names_from = "earner_type_d", values_from = "cost_burden")
  

trend(CB_earntype, 
      multiple_earner:single_fem_earner:single_male_earner, 
      pctiles = F,
      plot_title = "Cost Burden by Earner Type",
      cat = c("Multiple Earners" = "multiple_earner", "Single Female Earner" = "single_fem_earner", "Single Male Earner" = "single_male_earner"),
      y_title = 'Percent',
      caption_text = 
      "Source Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

m <- trend_data_maxmin(CB_earntype, "single_fem_earner")

# creates change variable starting at year 2000...perc point change in female sing eaners that are cost burdened
CB_earntype %>%
group_by(FIPS) %>%
mutate(change = single_fem_earner - single_fem_earner[year == 2000]) %>%
ungroup()%>%
  ranking_data("change")%>% 
  pull_peers(add_info=T)

Homeownership

by demographic

### Female Homeowner Proportions

w_howner <- lville_2019 %>%
  filter(sex == "female")

prop.table(table(w_howner$homeownership)) #0.7017448 are home owner

### Age of Female Homeowners

female_age_howner <- lville_2019 %>%
  filter(sex == "female") %>%
  group_by(homeownership) %>%
  summarize(
    ten_pct = Hmisc::wtd.quantile(age, HHWT, probs = 0.1),
    twenty_five_pct = Hmisc::wtd.quantile(age, HHWT, probs = 0.25),
    fifty_pct = Hmisc::wtd.quantile(age, HHWT, probs = 0.5),
    seventy_five_pct = Hmisc::wtd.quantile(age, HHWT, probs = 0.75),
    ninety_pct = Hmisc::wtd.quantile(age, HHWT, probs = 0.9),
    avg = mean(age))

female_age_howner #avg age for female homeowner is 57.92618

### Female Homeowners with & withut Kids Proportions

kid_howner <- lville_2019 %>%
  filter(sex == "female",
         homeownership == TRUE)

prop.table(table(kid_howner$kd_pres)) #0.3379953 women homeowners have kids

#also compares earner types
temp_df <- H_earntype %>%
  filter(race == 'total') %>%
  pivot_wider(names_from = "earner_type_d", values_from = "homeownership")

trend(temp_df, 
      multiple_earner:single_male_earner,
      plot_title = "Homeownership by Year", 
      cat = c("Multiple Earners" = "multiple_earner", "Single Female" = "single_fem_earner", "Single Male" = "single_male_earner"),
      pctiles = F,
      y_title = 'Percent',
      rollmean = 3,
      caption_text = 
      "Source: Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

by presence of kids

trend

H_earntype_kids %<>%
  filter(
    var_type == 'percent',
    sex == "female") %>%
  pivot_wider(names_from = 'kd_pres', values_from = 'homeownership') %>%
  select(-sex)


trend(H_earntype_kids, 
      kids:no_kids,
      rollmean = 3,
      plot_title = "Female Homeownership by Presence of Children", 
      cat = c("Children" = "kids", "No Children" = "no_kids"), 
      y_title = 'Percent',
      caption_text = 
      "Source: Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

Without children

ranking(H_earntype_kids, 
        'no_kids',
        plot_title = "Single Earner Female Homeownership",
        caption_text = 
      "Source: Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

Ranking with Children

ranking(H_earntype_kids,
        'kids',
        plot_title = "Single Earner Female Homeownership with Children",
        #title_scale = 0.8,
        caption_text = 
      "Source: Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

by Race

trend(filter(H_earntype, earner_type_d == "single_fem_earner"), 
      homeownership, 
      rollmean = 5,
      pctiles = F,
      plot_title = "Single Female Homeownership by Year", 
      cat = 'race', 
      y_title = 'Percent',
      caption_text = 
      "Source Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

by Race and Children

With Children

trend(H_earntype_kids, 
      kids, 
      rollmean = 5,
      pctiles = F,
      plot_title = "Single Female Homeownership by Year with Children", 
      cat = 'race', 
      y_title = 'Percent',
      caption_text = 
      "Source Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

Without Children

trend(H_earntype_kids, 
      no_kids, 
      rollmean = 5,
      pctiles = F,
      plot_title = "Single Female Homeownership by Year without Children", 
      cat = 'race', 
      y_title = 'Percent',
      caption_text = 
      "Source Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")

Education

Education Level

By Gender

E_singM_singF <- census_microdata081122_person %>% 
  filter(year %in% 2017:2019, 
         earner_type == 'single_earner') %>%
  group_by(sex, educ) %>%
  summarize(n=sum(PERWT, na.rm = TRUE)) %>%
  mutate(
    total = sum(n),
    rate = n/sum(n)*100,
    educ = factor(educ, 
                  levels = rev(c("no_hs", "hs", "some_col", "assoc", "bach","grad")), 
                  ordered = TRUE))


E_singM_singF_plot <- ggplot(E_singM_singF, 
       aes(x=sex, 
           y=rate, 
           fill = educ)) + 
  geom_bar(stat="identity", position = "fill") 


#E_singM_singF_plot <- E_singM_singF_plot + facet_wrap(~kd_pres) 
  
E_singM_singF_plot <- E_singM_singF_plot + glp_graph_theme

E_singM_singF_plot <- E_singM_singF_plot + 
  
  theme(
    legend.position = "right"
    ) +

  labs(
  title = "Single Earner Education Levels by Gender",
) + 
  scale_fill_discrete(
    labels = c("Graduate","Bachelor", "Associate", "Some College",  "High School", "No High School")) + 
  scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
  
  scale_y_continuous(labels = scales::percent)

E_singM_singF_plot

By presence of Children

E_singM_singF <- census_microdata081122_person %>% 
  filter(year %in% 2017:2019, 
         earner_type == 'single_earner') %>%
  group_by(sex, educ, kd_pres) %>%
  summarize(n=sum(PERWT, na.rm = TRUE)) %>%
  mutate(
    total = sum(n),
    rate = n/sum(n)*100,
    educ = factor(educ, 
                  levels = rev(c("no_hs", "hs", "some_col", "assoc", "bach","grad")), 
                  ordered = TRUE))


E_singM_singF_plot <- ggplot(E_singM_singF, 
       aes(x=sex, 
           y=rate, 
           fill = educ)) + 
  geom_bar(stat="identity", position = "fill") 


E_singM_singF_plot <- E_singM_singF_plot + facet_wrap(~kd_pres) 
  
E_singM_singF_plot <- E_singM_singF_plot + glp_graph_theme

E_singM_singF_plot <- E_singM_singF_plot + 
  
  theme(
    legend.position = "right"
    ) +

  labs(
  title = "Single Earner Education Levels by Gender and Childrens",
) + 
  ylab(" ") +
  xlab(" ") +
  scale_fill_discrete(
    labels = c("Graduate","Bachelor", "Associate", "Some College",  "High School", "No High School")) + 
  scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
  
  scale_y_continuous(labels = scales::percent)

E_singM_singF_plot

by race

E_singF_race <- lville_2019 %>% 
  filter(
    sex == 'female',
    earner_type == 'single_earner') %>%
  group_by(race, educ) %>%
  summarize(n=sum(PERWT, na.rm = TRUE)) %>%
  mutate(
    total = sum(n),
    rate = n/sum(n)*100,
    educ = factor(educ, 
                  levels = rev(c("no_hs", "hs", "some_col", "assoc", "bach","grad")), 
                  ordered = TRUE))

ggplot(E_singF_race, aes(x = "", y = rate, fill = educ)) +
  geom_bar(stat="identity", width=1, color="white") +
  geom_text(aes(label = scales::percent(rate, scale = 1, accuracy = 0.1)),
            position = position_stack(vjust = 0.5),
            size = 24,
            color = "white") +
  coord_polar("y", start=0) +
  
    glp_graph_theme + 
  
  scale_fill_manual(name = "",
                    values = c("#0E4A99", "#F58021", "#00A9B7", "#800055", "#356E39", "#CFB94C"),
                    labels = c("Graduate","Bachelor", "Associate", "Some College",  "High School", "No High School")) +
  
  labs(
    title = "") + 
  
    theme(
  axis.title.x=element_blank(),
  axis.title.y=element_blank(),
  axis.text = element_blank()
  #strip.text = element_blank()

  )  +

  facet_wrap(~race) 

### none of the edu below will be used
edu_by_kids <- function(race_group) {
  
  v <- census_microdata081122_person %>% 
  filter(year %in% 2017:2019, 
         earner_type == 'single_earner',
         race == race_group) %>%
  group_by(sex, educ, kd_pres) %>%
  summarize(n=sum(PERWT, na.rm = TRUE)) %>%
  mutate(
    total = sum(n),
    rate = n/sum(n)*100,
    educ = factor(educ, 
                  levels = rev(c("no_hs", "hs", "some_col", "assoc", "bach","grad")), 
                  ordered = TRUE))


v <- ggplot(E_singM_singF, 
       aes(x=sex, 
           y=rate, 
           fill = educ)) + 
  geom_bar(stat="identity", position = "fill") 


v <- v + facet_wrap(~kd_pres) 
  
v <- v + glp_graph_theme

v <- v + 
  
  theme(
    legend.position = "right"
    ) +

  labs(
  title = "Single Earner Education Levels by Gender",
) + 
  ylab(" ") +
  xlab(" ") +
  scale_fill_discrete(
    labels = c("Graduate","Bachelor", "Associate", "Some College",  "High School", "No High School")) + 
  scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
  
  scale_y_continuous(labels = scales::percent)

v
  
}

edu_by_kids("black")

edu_by_kids("white")


edu_by_kids("hispanic")

edu_by_kids("other")

E_singF_race <- lville_2019 %>% 
  filter(
    sex == 'female',
    earner_type == 'single_earner') %>%
  group_by(race, educ) %>%
  summarize(n=sum(PERWT, na.rm = TRUE)) %>%
  mutate(
    total = sum(n),
    rate = n/sum(n)*100,
    educ = factor(educ, 
                  levels = rev(c("no_hs", "hs", "some_col", "assoc", "bach","grad")), 
                  ordered = TRUE))

E_singF_race_plot <- ggplot(E_singF_race, aes(x=race, y=rate, fill=educ)) + 
geom_bar(stat="identity", position='fill')


E_singF_race_plot <- E_singF_race_plot + glp_graph_theme

E_singF_race_plot <- E_singF_race_plot + 
    theme(
    legend.position = "right"
    ) +
  labs(
  title = "Single Female Education Breakdown",
) + 
  ylab(" ") +
  xlab("Race") +
  scale_fill_discrete(labels = c("Graduate","Bachelor", "Associate", "Some College",  "High School", "No High School")) + 
  scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
  
  scale_y_continuous(labels = scales::percent)

E_singF_race_plot

##earner types over time
earner_trend <- census_microdata081122_person %>%
  
  group_by(year, earner_type_d) %>%
  summarize(n=sum(HHWT, na.rm = TRUE)) %>%
  mutate(
    total = sum(n),
    rate = n/sum(n)*100) 
  
earner_trend_plt <- ggplot(earner_trend, 
       aes(x=year, y=rate, fill=earner_type_d),
        color="#00A9B7") + 
geom_bar(stat="identity", position='fill')


earner_trend_plt <- earner_trend_plt + glp_graph_theme

earner_trend_plt <- earner_trend_plt + 
    theme(
    legend.position = "right"
    #strip.text = element_blank()
    ) +
  labs(
  title = "Earner Type Trend"
) + 
  ylab(" ") +
  xlab(" ") +
  scale_fill_discrete(labels = c("Multiple Earner", "Single Female Earner", "Single Male Earner")) + 

  scale_y_continuous(labels = scales::percent)

earner_trend_plt

Appendix

Gender

What is Person X’s sex? Mark (X) ONE box.

[ ] Male

[ ] Female

Hispanic Descent

Is Person X of Hispanic, Latino, or Spanish origin?

[ ] No, not of Hispanic, Latino, or Spanish origin

[ ] Yes, Mexican, Mexican Am., Chicano

[ ] Yes, Puerto Rican

[ ] Yes, Cuban

[ ] Yes, another Hispanic, Latino, or Spanish origin – Print origin, for example, Argentinean, Colombian, Dominican, Nicaraguan, Salvadoran, Spaniard, and so on. –> ______________________________________

Race

What is Person X’s race? Mark (X) one or more boxes.

[ ] White

[ ] Black or African Am.

[ ] American Indian or Alaska Native – Print name of enrolled or principal tribe. –> __________________

[ ] Asian Indian

[ ] Japanese

[ ] Native Hawaiian

[ ] Chinese

[ ] Korean

[ ] Guamanian or Chamorro

[ ] Filipino

[ ] Vietnamese

[ ] Samoan

[ ] Other Asian – Print race, for example, Hmong, Laotian, Thai, Pakistani, Cambodian, and so on. –> _____________________

[ ] Other Pacific Islander – Print race, for example, Fijian, Tongan, and so on. –>______________________

[ ] Some other race – Print race. –> ____________________________________________________

Ranking with Children

ranking(H_earntype_kids,
        'kids',
        plot_title = "Single Earner Female Homeownership with Children",
        #title_scale = 0.8,
        caption_text = 
      "Source: Greater Louisville Project
       Data from GLP analysis of ACS microdata from IPUMS-USA")